home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Presentations / Presentations ’93 / Voice Toolkit / Voice Experience < prev    next >
Encoding:
Text File  |  1992-11-25  |  1.9 KB  |  69 lines  |  [TEXT/CCL2]
  1.  
  2. (in-package "VOICE-TOOLKIT")
  3.  
  4. (defun make-twin (word count prob)
  5.   (list word count prob))
  6.  
  7. (defun twin-count (twin)
  8.   (second twin))
  9.  
  10. (defun twin-word (twin)
  11.   (first twin))
  12.  
  13. (defun twin-prob (twin)
  14.   (third twin))
  15.  
  16. (defun twin-weight (twin)
  17.   (/ (twin-prob twin) (twin-count twin)))
  18.  
  19. (defparameter *twintable* (make-hash-table :test #'equal))
  20.  
  21. (defun hash-twin (word twin)
  22.   (setf (gethash word *twintable*)
  23.         (add-twin twin (gethash word *twintable*))))
  24.  
  25. (defun add-twin (twin twinlist)
  26.   (cond ((null twinlist) (list twin))
  27.         ((equal (twin-word twin)
  28.                 (twin-word (first twinlist)))
  29.          (cons (make-twin (twin-word twin)
  30.                           (+ (twin-count twin)
  31.                              (twin-count (first twinlist)))
  32.                           (+ (twin-prob twin)
  33.                              (twin-prob (first twinlist))))
  34.                (rest twinlist)))
  35.         (t (cons (first twinlist) (add-twin twin (rest twinlist))))))
  36.  
  37. (defun report-twins ()
  38.   (let ((report nil))
  39.     (maphash #'(lambda (word twinlist)
  40.                  (setf report (cons (cons word twinlist) report)))
  41.              *twintable*)
  42.     report))
  43.  
  44. (defun get-twins (word)
  45.   (gethash word *twintable*))
  46.  
  47. (defun file-twins (report)
  48.   (let ((file
  49.          (open "COOKIE:Voice Toolkit;Experience File"
  50.                :direction :output 
  51.                :if-exists :overwrite
  52.                :if-does-not-exist :create)))
  53.     (write report :stream file)
  54.     (close file)))
  55.  
  56. (defun load-twins ()
  57.   (let ((file
  58.          (open "COOKIE:Voice Toolkit;Experience File"
  59.                :direction :input
  60.                :if-does-not-exist nil)))
  61.     (mapcar #'(lambda (twinline)
  62.                 (mapcar #'(lambda (twin)
  63.                             (hash-twin (first twinline) twin))
  64.                         (rest twinline)))
  65.             (if file (read file)))
  66.     (close file)))
  67.          
  68.          
  69.